perm filename TABL.OLD[XX,LCS] blob
sn#217047 filedate 1976-05-23 generic text, type T, neo UTF8
00100 C** TABL.F4 ** CONVERTS STANDARD NOTATION TO 1700 LUTE TABLATURE.
00200
00300 SUBROUTINE EXTRA
00400 IMPLICIT INTEGER(A-Q,S-Z)
00500 COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20) /STF/RSC(8),RSTJ2
00550 1 /POSI/SF(8),JJ2,RPOS /PTR/KWDS(250),ITEM,L,I,IX /XRN/RN(4000)
00600 EQUIVALENCE (R4,RJQ(2)),(J5,JQ(3)),(R6,RJQ(4)),(R3,RJQ(1))
00700 1 ,(J6,JQ(4)),(R11,RJQ(9)),(J10,JQ(8)),(R5,RJQ(3)),(J3,JQ(1))
00800 1,(J11,JQ(9)),(RX3,RJQ(20)),(R9,RJQ(7)),(R8,RJQ(6)),(JR3,RJQ(19))
00850 1,(J7,JQ(5))
00900
01000 DIMENSION RS(5),KEY(10),ISTR(6)
01100 DATA RS/2.,4.,6.,9.,11./,KEY/3,0,4,1,-1,5,2,6,3,0/
01200 1,ISTR/0,5,8,12,17,20/,KSIG/9/
01300 C RS CONVERTS STRING NUM TO LINE NUM. KEY INCL'S. 4b TO 5#
01400 C ISTR HAS 12-TONE NOTE NUM OF STRINGS 1 TO 6(A=0)
01500
01510 GO TO (1,2),JA
01520 1 IF(KSIG.LE.8)GO TO 51
01530 C NEXT SEARCHES FOR KSIG, AT LEAST ONCE. SET P11=8 TO CANCEL KSIG FEATURE
01540 IF(J11.NE.0)GO TO 51
01550 DO 52 K=1,ITEM
01560 L=KWDS(K)
01570 IF(RN(L+1).NE.17)GO TO 52
01575 IF(RN(L+2).NE.R2)GO TO 52
01580 KSIG=RN(L+5)
01590 GO TO 51
01600 52 CONTINUE
01605 KSIG=8
01607 C SO IT WON'T SEARCH EVERY TIME. NOW KSIG MUST BE SET BY P11.
01610 GO TO 51
01700 15 J10=0
01705 51 IF(J10.NE.0)GO TO 50
01707 C STRNG NUM CAN BE SET IN J10 OR IN R6 -- 1=.001, 2=.002, ETC. J10 IS FIRST.
01708 C R6 IS USED IN 'TAB.F4' WHICH CONVERTS TABLATURE TO MS INPUT.
01710 R6=AMOD(R6*100.0,10.0)
01715 C R6 WAS MULTIPLIED BY 10 IN NOTWRT. .001 HAS BECOME .01, ETC.
01720 J10=R6
01740 IF(J10.NE.0)J6=0
01750 C MAKE J6=0 IF AUTOMATIC STRING NUMS ARE IN DECIS OF R6.
01760 R6=0
01780 50 IF(J10.EQ.0)GO TO 18
01782 C TO SPECIFY LETTER (P6), P10 MUST! ALSO BE NON-ZERO. (USE P10>6 FOR STR.0)
01785 IF(J10.GT.6)J10=7
01790 J10=7-J10
01800 IF(J6.EQ.0)GO TO 18
01900 C J10 SETS STRING# (6→-6), J6 SETS LET. OR NUM.(e.g.'-4' PRINTS '4',1=A)
01975 C STRINGS ARE NUMBERED FROM HIGH TO LOW
02000 L=J10*2-1
02100 C GETS STAFF POS FROM STRING NUM.
02200 N=J6-1
02300 IF(J10.GE.0.AND.N.GE.0)GO TO 9
02350 N=N+1
02400 16 L=-1
02500 C STRINGS 0 TO -6 ALL APPEAR BELOW 6-LINE STAFF.
02600 IF(N.GT.0)GO TO 9
02700 C JUMP IF FINGERED NOTE ON STRING 0
02705 IF(N.EQ.0)GO TO 13
02710 L=-2
02800 IF(N.LT.-3)GO TO 30
02900 C NEXT FOR SLASHES OVER a.
02910 R4=1.0
02920 R5=2.4
02930 IF(N.EQ.-1)GO TO 33
02940 L=-3
03000 R4=0
03100 R5=1.4
03200 33 JR3=R3
03300 C SAVE FOR LATER
03400 R3=R3-7.*RSTJ2
03500 R6=RX3+4*RSTJ2
03600 C RX3 IS ORIG. HORIZ. POS. (SCALE 0-200)
04000 JA=4
04010 J7=1
04050 RP=RPOS
04075 C SAVE VERT. POS. BASIS
04100 DO 32 K=1,-N
04200 J10=1
04250 R8=4.2
04260 R9=0
04300 CALL ITMSUB
04310 J3=JR3
04350 RPOS=RP
04400 R4=R4+.7
04500 32 R5=R5+.7
04700 N=0
04800 GO TO 13
04810 30 IF(N.GT.8)N=N+1
04855 C THE LETTER 'J' IS SKIPPED IN TABLATURE.
04900 R6=51009999.-N*10000
05000 GO TO 31
05100
05200 18 J=MOD(J5,10)
05300 M=R4
05310 IF(M.GT.-2)GO TO 21
05320 N=M+2
05330 GO TO 16
05400 21 N=MOD(M-1,7)+2
05500 IF(N.GT.6)N=N-7
05600 C N IS NOTE NUMBER, WHERE A3=0
05700 IF(N)GO TO 16
05800 C FOR ALL NOTES BELOW A3 GO BACK TO J6 ROUTINE.
05900 IF(J.EQ.0)GO TO 6
06000 C JUMP IF NO ACCI.
06100
06200 IF(J.EQ.1)J=-1
06300 IF(J.EQ.2)J=1
06400 IF(J.EQ.3)J=0
06500 C J= 1/2 STEP FROM CENTRAL PITCH
06600 GO TO 7
06700 6 IF(J11.NE.0)KSIG=J11
06705 IF(KSIG.GT.7)GO TO 7
06720 C J11>7 CANCELS KSIG
06800 C GIVE KEYSIG. IN P11 +=#, -=b
06900 M=KSIG+5
07000 J=1
07100 IF(KSIG)J=-1
07200 DO 4 K=5,M,J
07300 4 IF(N.EQ.KEY(K))GO TO 7
07400 C LOOK FOR THE NOTE IN THE KEYSIG.
07500 J=0
07600 C 0= NOT FOUND IN KEYSIG.
07620 7 R11=0
07700 IF(J10.GT.0)GO TO 5
07800 C JUMP IF STRING IS SPECIFIED
07900 DO 10 L=1,5
08000 10 IF(R4.LT.RS(L))GO TO 20
08100 L=6
08200 C L IS STRING NUMBER.
08300 20 L=L*2-1
08400 IF(J.GE.0)GO TO 5
08500 C NEXT CHECKS FOR FLATS THAT CHANGE STRING NUM.
08600 IF(N.EQ.0)GO TO 8
08700 IF(N.EQ.3)GO TO 8
08800 IF(N.NE.5)GO TO 5
08900 CC8 L=L-1
09000 C CHANGES Ab→G#, Db→C#
09100 CC N=N-1
09200 CC J=1
09210 8 R4=R4-1.
09220 J5=2
09230 GO TO 18
09300 C DOESN'T ACCOUNT FOR F FLAT, ETC.
09400
09500 5 NN=N*2
09600 C NEXT CONVERTS TO 12-TONE NUMS.
09700 IF(N.GT.1)NN=NN-1
09800 IF(N.GT.4)NN=NN-1
09900 C COMPENSATES FOR B-C AND E-F 1/2 STEPS IN SCALE
10000 N=NN
10100 IF(J10.GT.0)GO TO 14
10200 IF(R4.GE.13)GO TO 17
10300 IF(NN.GT.4)N=NN-5
10400 IF(NN.GT.7)N=NN-8
10500 C N IS NOW A LETTER ON A OR D OR F STRING (0=A, 1=B, ETC.)
10600
10700 11 N=N+J
10800 GO TO 9
10900 17 J10=6
11000 14 IF(J10.GT.6)GO TO 15
11100 R5=R4
11200 IF(J)R5=R5-1.
11300 IF(R5.GE.6.)N=N+12
11400 IF(R5.GE.13.)N=N+12
11500 N=N-ISTR(J10)+J
11600 IF(N)GO TO 15
11700 L=J10*2-1
11800
11900 9 IF(N.EQ.2)N=17
12000 C CHANGES C TO R
12100 13 R6=51709999.0+N*10000
12200 31 R5=.95
12300 R4=L+1.28125
12400 IF(N.EQ.3)R11=268
12500 C ROTATES 'D'
12550 J3=J3+6.*RSTJ2
12600 CALL ALPHA
12700 2 END